home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / amos / amos_col.lha / AMOS-COL / Scroll3.amos / Scroll3.amosSourceCode < prev    next >
AMOS Source Code  |  1980-01-10  |  2KB  |  108 lines
  1. '
  2. 'DELTA/BUCKET 24.10.1996 
  3. '
  4. '�ukasz ï¿½elezny
  5. 'ul. W�oska 4d/6 
  6. '42-600 Tarnowskie G�ry
  7. 'POLAND
  8. '
  9. 'Hi to: Raptor, Starlight, Vook, The Soul, Lobo
  10. '
  11. '  
  12. _SCROLL
  13. Procedure _SCROLL
  14.    Trap Screen Close 0
  15.    Hide On 
  16.    Led Off 
  17.    Track Play 
  18.    Track Loop On 
  19.    Unpack 10 To 0
  20.    Screen Open 1,320,256,8,Lowres
  21.    For K=1 To 2 : Cls 0 : Next 
  22.    Dual Playfield 0,1
  23.    Dual Priority 1,0
  24.    Double Buffer : Autoback 0
  25.    OPEN_FONT["scala",8]
  26.    Set Font Param
  27.    Curs Off : Palette 0,$FFF : Cls 0 : Pen 1 : Paper 0
  28.    Def Scroll 1,0,50 To 640,200,0,-2
  29.    Restore DATY
  30.    MX=100
  31.    Dim T$(MX)
  32.    For NR=1 To MX
  33.       Read T$(NR)
  34.       If T$(NR)="*" Then Exit 
  35.    Next 
  36.    NR=1
  37.    Ink 1,0
  38.    Screen To Front 0
  39.    Screen 1
  40.    Gr Writing 0
  41.    Do 
  42.       Screen 1
  43.       Text 10,200-12,T$(NR)
  44.       Inc NR
  45.       If T$(NR)="*" Then NR=1
  46.       For SCRL=1 To 10
  47.          Screen 1 : Scroll 1
  48.          Screen Swap 
  49.          Screen Copy Physic To Logic
  50.       Next SCRL
  51.       
  52.    Loop 
  53.    
  54.    DATY: Data "CREDITS"
  55.    Data "ALL CODING: DELTA OF BUCKET"
  56.    Data "MSX: JAKA MSX ???"
  57.    Data "GFX: DELTA"
  58.    Data "This is a new routine made by DELTA"
  59.    Data ""
  60.    Data "******************"
  61.    Data "* DELTA'S SCROLL *"
  62.    Data "******************"
  63.    Data ""
  64.    Data "This is a dual playfileld mode..."
  65.    Data ""
  66.    Data ""
  67.    Data "*"
  68. End Proc
  69. Procedure OPEN_FONT[NAZWA$,ROZMIAR]
  70.    BLAD=0
  71.    If Lower$(Right$(NAZWA$,5))<>".font"
  72.       NAZWA$=NAZWA$+".font"
  73.    End If 
  74.    NAZWA$=NAZWA$+Chr$(0)
  75.    Dreg(0)=7 : Dreg(1)=0
  76.    ADRES=Execall(-198)
  77.    If ADRES=0 Then BLAD=24
  78.    Loke ADRES,Varptr(NAZWA$)
  79.    Doke ADRES+4,ROZMIAR
  80.    Doke ADRES+6,0
  81.    FONT=Gfxcall(-72)
  82.    If FONT=0
  83.       Lib Open 1,"diskfont.library",0
  84.       Areg(0)=ADRES : Areg(1)=ADRES
  85.       FONT=Lib Call(1,-30)
  86.       If FONT=0 : BLAD=44 : End If 
  87.    Else 
  88.       BLAD=44
  89.    End If 
  90.    If ADRES
  91.       Areg(1)=ADRES
  92.       Dreg(0)=7
  93.       X=Execall(-210)
  94.    End If 
  95.    If BLAD=0
  96.       Get Rom Fonts 
  97.       FONT=0
  98.       N$=Upper$(Left$(NAZWA$,Len(NAZWA$)-6))
  99.       Repeat 
  100.          Inc FONT
  101.          A$=Upper$(Font$(FONT))
  102.          A$=Left$(A$,Instr(A$,".FONT")-1)
  103.          A=Val(Mid$(Font$(FONT),31,5))
  104.       Until(A$=N$ and A=ROZMIAR) or(A$="")
  105.    Else 
  106.       Error BLAD
  107.    End If 
  108. End Proc[FONT]